home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / OBJECT.H < prev    next >
C/C++ Source or Header  |  1992-02-10  |  19KB  |  506 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/object.h,v 9.37 1992/02/10 13:05:22 jinx Exp $
  4.  
  5. Copyright (c) 1987-1992 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* This file defines the macros which define and manipulate Scheme
  36.    objects.  This is the lowest level of abstraction in this program. */
  37.  
  38. /* The value in "Wsize.c" for `TYPE_CODE_LENGTH' must match this!! */
  39. #ifndef TYPE_CODE_LENGTH
  40. #define TYPE_CODE_LENGTH 8
  41. #endif
  42.  
  43. #ifdef MIN_TYPE_CODE_LENGTH
  44. #if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
  45. #include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
  46. #endif
  47. #endif
  48.  
  49. #ifdef b32            /* 32 bit word versions */
  50. #if (TYPE_CODE_LENGTH == 8)
  51.  
  52. #define MAX_TYPE_CODE        0xFF
  53. #define DATUM_LENGTH        24
  54. #define FIXNUM_LENGTH        23
  55. #define FIXNUM_SIGN_BIT        0x00800000
  56. #define SIGN_MASK        0xFF800000
  57. #define SMALLEST_FIXNUM        ((long) 0xFF800000)
  58. #define BIGGEST_FIXNUM        ((long) 0x007FFFFF)
  59. #define HALF_DATUM_LENGTH    12
  60. #define HALF_DATUM_MASK        0x00000FFF
  61. #define DATUM_MASK        0x00FFFFFF
  62. #define TYPE_CODE_MASK        0xFF000000
  63.  
  64. #endif /* (TYPE_CODE_LENGTH == 8) */
  65. #if (TYPE_CODE_LENGTH == 6)
  66.  
  67. #define MAX_TYPE_CODE        0x3F
  68. #define DATUM_LENGTH        26
  69. #define FIXNUM_LENGTH        25
  70. #define FIXNUM_SIGN_BIT        0x02000000
  71. #define SIGN_MASK        0xFE000000
  72. #define SMALLEST_FIXNUM        ((long) 0xFE000000)
  73. #define BIGGEST_FIXNUM        ((long) 0x01FFFFFF)
  74. #define HALF_DATUM_LENGTH    13
  75. #define HALF_DATUM_MASK        0x00001FFF
  76. #define DATUM_MASK        0x03FFFFFF
  77. #define TYPE_CODE_MASK        0XFC000000
  78.  
  79. #endif /* (TYPE_CODE_LENGTH == 6) */
  80. #endif /* b32 */
  81. #ifndef DATUM_LENGTH        /* Safe versions */
  82.  
  83. #define MAX_TYPE_CODE        ((1 << TYPE_CODE_LENGTH) - 1)
  84. #define DATUM_LENGTH        (OBJECT_LENGTH - TYPE_CODE_LENGTH)
  85. /* FIXNUM_LENGTH does NOT include the sign bit! */
  86. #define FIXNUM_LENGTH        (DATUM_LENGTH - 1)
  87. #define FIXNUM_SIGN_BIT        (1 << FIXNUM_LENGTH)
  88. #define SIGN_MASK        ((long) (-1 << FIXNUM_LENGTH))
  89. #define SMALLEST_FIXNUM        ((long) (-1 << FIXNUM_LENGTH))
  90. #define BIGGEST_FIXNUM        ((1 << FIXNUM_LENGTH) - 1)
  91. #define HALF_DATUM_LENGTH    (DATUM_LENGTH / 2)
  92. #define HALF_DATUM_MASK        ((1 << HALF_DATUM_LENGTH) - 1)
  93. #define DATUM_MASK        ((1 << DATUM_LENGTH) - 1)
  94. #define TYPE_CODE_MASK        (~ DATUM_MASK)
  95.  
  96. #endif /* DATUM_LENGTH */
  97.  
  98. /* Basic object structure */
  99.  
  100. #ifndef OBJECT_TYPE
  101. #ifdef UNSIGNED_SHIFT_BUG
  102. /* This fixes bug in some compilers. */
  103. #define OBJECT_TYPE(object) (((object) >> DATUM_LENGTH) & MAX_TYPE_CODE)
  104. #else
  105. /* Faster for logical shifts */
  106. #define OBJECT_TYPE(object) ((object) >> DATUM_LENGTH)
  107. #endif
  108. #endif
  109.  
  110. #define OBJECT_DATUM(object) ((object) & DATUM_MASK)
  111. #define OBJECT_ADDRESS(object) (DATUM_TO_ADDRESS ((object) & DATUM_MASK))
  112.  
  113. #define MAKE_OBJECT(type, datum)                    \
  114.   ((((unsigned long) (type)) << DATUM_LENGTH) | (datum))
  115.  
  116. #define OBJECT_NEW_DATUM(type_object, datum)                \
  117.   (((type_object) & TYPE_CODE_MASK) | (datum))
  118.  
  119. #define OBJECT_NEW_TYPE(type, datum_object)                \
  120.   (MAKE_OBJECT ((type), (OBJECT_DATUM (datum_object))))
  121.  
  122. #define MAKE_OBJECT_FROM_OBJECTS(type_object, datum_object)        \
  123.   (((type_object) & TYPE_CODE_MASK) | ((datum_object) & DATUM_MASK))
  124.  
  125. #define MAKE_POINTER_OBJECT(type, address)                \
  126.   (MAKE_OBJECT ((type), (ADDRESS_TO_DATUM (address))))
  127.  
  128. #define OBJECT_NEW_ADDRESS(object, address)                \
  129.   (OBJECT_NEW_DATUM ((object), (ADDRESS_TO_DATUM (address))))
  130.  
  131. /* Machine dependencies */
  132.  
  133. #ifdef HEAP_IN_LOW_MEMORY    /* Storing absolute addresses */
  134.  
  135. typedef long relocation_type;    /* Used to relocate pointers on fasload */
  136.  
  137. /* The "-1" in the value returned is a guarantee that there is one
  138.    word reserved exclusively for use by the garbage collector. */
  139. #define ALLOCATE_HEAP_SPACE(space)                    \
  140.   (Heap =                                \
  141.     ((SCHEME_OBJECT *) (malloc ((sizeof (SCHEME_OBJECT)) * (space)))),    \
  142.    ((Heap + (space)) - 1))
  143.  
  144. #ifndef DATUM_TO_ADDRESS
  145. #define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) (datum))
  146. #endif
  147.  
  148. #ifndef ADDRESS_TO_DATUM
  149. #define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) (address))
  150. #endif
  151.  
  152. #else /* not HEAP_IN_LOW_MEMORY (portable version) */
  153.  
  154. /* Used to relocate pointers on fasload */
  155.  
  156. typedef SCHEME_OBJECT * relocation_type;
  157.  
  158. extern SCHEME_OBJECT * memory_base;
  159.  
  160. /* The "-1" in the value returned is a guarantee that there is one
  161.    word reserved exclusively for use by the garbage collector. */
  162. #define ALLOCATE_HEAP_SPACE(space)                    \
  163.   (memory_base =                            \
  164.     ((SCHEME_OBJECT *) (malloc ((sizeof (SCHEME_OBJECT)) * (space)))),    \
  165.    Heap = memory_base,                            \
  166.    ((memory_base + (space)) - 1))
  167.  
  168. #ifndef DATUM_TO_ADDRESS
  169. #define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) ((datum) + memory_base))
  170. #endif
  171.  
  172. #ifndef ADDRESS_TO_DATUM
  173. #define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) ((address) - memory_base))
  174. #endif
  175.  
  176. #endif /* HEAP_IN_LOW_MEMORY */
  177.  
  178. /* Lots of type predicates */
  179.  
  180. #define FIXNUM_P(object) ((OBJECT_TYPE (object)) == TC_FIXNUM)
  181. #define BIGNUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM)
  182. #define FLONUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FLONUM)
  183. #define COMPLEX_P(object) ((OBJECT_TYPE (object)) == TC_COMPLEX)
  184. #define CHARACTER_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER)
  185. #define STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING)
  186. #define BIT_STRING_P(object) ((OBJECT_TYPE (object)) == TC_BIT_STRING)
  187. #define CELL_P(object) ((OBJECT_TYPE (object)) == TC_CELL)
  188. #define PAIR_P(object) ((OBJECT_TYPE (object)) == TC_LIST)
  189. #define WEAK_PAIR_P(object) ((OBJECT_TYPE (object)) == TC_WEAK_CONS)
  190. #define VECTOR_P(object) ((OBJECT_TYPE (object)) == TC_VECTOR)
  191. #define BOOLEAN_P(object) (((object) == SHARP_T) || ((object) == SHARP_F))
  192. #define REFERENCE_TRAP_P(object) ((OBJECT_TYPE (object)) == TC_REFERENCE_TRAP)
  193. #define PRIMITIVE_P(object) ((OBJECT_TYPE (object)) == TC_PRIMITIVE)
  194. #define FUTURE_P(object) ((OBJECT_TYPE (object)) == TC_FUTURE)
  195. #define PROMISE_P(object) ((OBJECT_TYPE (object)) == TC_DELAYED)
  196. #define APPARENT_LIST_P(object) (((object) == EMPTY_LIST) || (PAIR_P (object)))
  197. #define CONTROL_POINT_P(object) ((OBJECT_TYPE (object)) == TC_CONTROL_POINT)
  198. #define BROKEN_HEART_P(object) ((OBJECT_TYPE (object)) == TC_BROKEN_HEART)
  199. #define GC_NON_POINTER_P(object) ((GC_Type (object)) == GC_Non_Pointer)
  200. #define GC_CELL_P(object) ((GC_Type (object)) == GC_Cell)
  201. #define GC_PAIR_P(object) ((GC_Type (object)) == GC_Pair)
  202. #define GC_TRIPLE_P(object) ((GC_Type (object)) == GC_Triple)
  203. #define GC_QUADRUPLE_P(object) ((GC_Type (object)) == GC_Quadruple)
  204. #define GC_VECTOR_P(object) ((GC_Type (object)) == GC_Vector)
  205.  
  206. #define COMPILED_CODE_ADDRESS_P(object)                    \
  207.   ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY)
  208.  
  209. #define STACK_ADDRESS_P(object)                        \
  210.   ((OBJECT_TYPE (object)) == TC_STACK_ENVIRONMENT)
  211.  
  212. #define NON_MARKED_VECTOR_P(object)                    \
  213.   ((OBJECT_TYPE (object)) == TC_NON_MARKED_VECTOR)
  214.  
  215. #define SYMBOL_P(object)                        \
  216.   (((OBJECT_TYPE (object)) == TC_INTERNED_SYMBOL) ||            \
  217.    ((OBJECT_TYPE (object)) == TC_UNINTERNED_SYMBOL))
  218.  
  219. #define INTEGER_P(object)                        \
  220.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  221.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM))
  222.  
  223. #define REAL_P(object)                            \
  224.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  225.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) ||                \
  226.    ((OBJECT_TYPE (object)) == TC_BIG_FLONUM))
  227.  
  228. #define NUMBER_P(object)                        \
  229.   (((OBJECT_TYPE (object)) == TC_FIXNUM) ||                \
  230.    ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) ||                \
  231.    ((OBJECT_TYPE (object)) == TC_BIG_FLONUM)                \
  232.    ((OBJECT_TYPE (object)) == TC_COMPLEX))
  233.  
  234. #define HUNK3_P(object)                            \
  235.   (((OBJECT_TYPE (object)) == TC_HUNK3_A) ||                \
  236.    ((OBJECT_TYPE (object)) == TC_HUNK3_B))
  237.  
  238. #define INTERPRETER_APPLICABLE_P interpreter_applicable_p
  239.  
  240. #define ENVIRONMENT_P(env)                        \
  241.   ((OBJECT_TYPE (env) == TC_ENVIRONMENT) ||                \
  242.    (OBJECT_TYPE (env) == GLOBAL_ENV))
  243.  
  244. /* Memory Operations */
  245.  
  246. /* The FAST_ operations are used only where the object is known to be
  247.    immutable.  On a parallel processor they don't require atomic
  248.    references. */
  249.  
  250. #define FAST_MEMORY_REF(object, offset)                    \
  251.   ((OBJECT_ADDRESS (object)) [(offset)])
  252.  
  253. #define FAST_MEMORY_SET(object, offset, value)                \
  254.   ((OBJECT_ADDRESS (object)) [(offset)]) = (value)
  255.  
  256. #define MEMORY_LOC(object, offset)                    \
  257.   (& ((OBJECT_ADDRESS (object)) [(offset)]))
  258.  
  259. /* General case memory access requires atomicity for parallel processors. */
  260.  
  261. #define MEMORY_REF(object, offset)                    \
  262.   (MEMORY_FETCH ((OBJECT_ADDRESS (object)) [(offset)]))
  263.  
  264. #define MEMORY_SET(object, offset, value)                \
  265.   MEMORY_STORE (((OBJECT_ADDRESS (object)) [(offset)]), (value))
  266.  
  267. /* Pair Operations */
  268.  
  269. #define FAST_PAIR_CAR(pair) (FAST_MEMORY_REF ((pair), CONS_CAR))
  270. #define FAST_PAIR_CDR(pair) (FAST_MEMORY_REF ((pair), CONS_CDR))
  271. #define FAST_SET_PAIR_CAR(pair, car) FAST_MEMORY_SET ((pair), CONS_CAR, (car))
  272. #define FAST_SET_PAIR_CDR(pair, cdr) FAST_MEMORY_SET ((pair), CONS_CDR, (cdr))
  273. #define PAIR_CAR_LOC(pair) (MEMORY_LOC ((pair), CONS_CAR))
  274. #define PAIR_CDR_LOC(pair) (MEMORY_LOC ((pair), CONS_CDR))
  275.  
  276. #define PAIR_CAR(pair) (MEMORY_REF ((pair), CONS_CAR))
  277. #define PAIR_CDR(pair) (MEMORY_REF ((pair), CONS_CDR))
  278. #define SET_PAIR_CAR(pair, car) MEMORY_SET ((pair), CONS_CAR, (car))
  279. #define SET_PAIR_CDR(pair, cdr) MEMORY_SET ((pair), CONS_CDR, (cdr))
  280.  
  281. /* Vector Operations */
  282.  
  283. #define VECTOR_LENGTH(vector) (OBJECT_DATUM (FAST_MEMORY_REF ((vector), 0)))
  284.  
  285. #define SET_VECTOR_LENGTH(vector, length)                \
  286.   FAST_MEMORY_SET                            \
  287.     ((vector),                                \
  288.      0,                                    \
  289.      (OBJECT_NEW_DATUM ((FAST_MEMORY_REF ((vector), 0)), (length))));
  290.  
  291. #define FAST_VECTOR_REF(vector, index)                    \
  292.   (FAST_MEMORY_REF ((vector), ((index) + 1)))
  293.  
  294. #define FAST_VECTOR_SET(vector, index, value)                \
  295.   FAST_MEMORY_SET ((vector), ((index) + 1), (value))
  296.  
  297. #define VECTOR_LOC(vector, index) (MEMORY_LOC ((vector), ((index) + 1)))
  298. #define VECTOR_REF(vector, index) (MEMORY_REF ((vector), ((index) + 1)))
  299.  
  300. #define VECTOR_SET(vector, index, value)                \
  301.   MEMORY_SET ((vector), ((index) + 1), (value))
  302.  
  303. /* String Operations */
  304.  
  305. /* Add 1 byte to length to account for '\0' at end of string.
  306.    Add 1 word to length to account for string header word. */
  307. #define STRING_LENGTH_TO_GC_LENGTH(length)                \
  308.   ((BYTES_TO_WORDS ((length) + 1)) + 1)
  309.  
  310. #define STRING_LENGTH(string)                        \
  311.   ((long) (MEMORY_REF ((string), STRING_LENGTH_INDEX)))
  312.  
  313. #define SET_STRING_LENGTH(string, length) do                \
  314. {                                    \
  315.   MEMORY_SET ((string), STRING_LENGTH_INDEX, (length));            \
  316.   STRING_SET ((string), (length), '\0');                \
  317. } while (0)
  318.  
  319. /* Subtract 1 to account for the fact that we maintain a '\0'
  320.    at the end of the string. */
  321. #define MAXIMUM_STRING_LENGTH(string)                    \
  322.   ((long) ((((VECTOR_LENGTH (string)) - 1) * (sizeof (SCHEME_OBJECT))) - 1))
  323.  
  324. #define SET_MAXIMUM_STRING_LENGTH(string, length)            \
  325.   SET_VECTOR_LENGTH ((string), (STRING_LENGTH_TO_GC_LENGTH (length)))
  326.  
  327. #define STRING_LOC(string, index)                    \
  328.   (((unsigned char *) (MEMORY_LOC (string, STRING_CHARS))) + (index))
  329.  
  330. #define STRING_REF(string, index)                    \
  331.   ((int) (* (STRING_LOC ((string), (index)))))
  332.  
  333. #define STRING_SET(string, index, c_char)                \
  334.   (* (STRING_LOC ((string), (index)))) = (c_char)
  335.  
  336. /* Character Operations */
  337.  
  338. #define ASCII_LENGTH CHAR_BIT    /* CHAR_BIT in config.h - 8 for unix  */
  339. #define CODE_LENGTH 7
  340. #define BITS_LENGTH 5
  341. #define MIT_ASCII_LENGTH 12
  342.  
  343. #define CHAR_BITS_META         01
  344. #define CHAR_BITS_CONTROL     02
  345. #define CHAR_BITS_CONTROL_META    03
  346.  
  347. #define MAX_ASCII (1 << ASCII_LENGTH)
  348. #define MAX_CODE (1 << CODE_LENGTH)
  349. #define MAX_BITS (1 << BITS_LENGTH)
  350. #define MAX_MIT_ASCII (1 << MIT_ASCII_LENGTH)
  351.  
  352. #define MASK_ASCII (MAX_ASCII - 1)
  353. #define CHAR_MASK_CODE (MAX_CODE - 1)
  354. #define CHAR_MASK_BITS (MAX_BITS - 1)
  355. #define MASK_MIT_ASCII (MAX_MIT_ASCII - 1)
  356.  
  357. #define ASCII_TO_CHAR(ascii) (MAKE_OBJECT (TC_CHARACTER, (ascii)))
  358. #define CHAR_TO_ASCII_P(object) ((OBJECT_DATUM (object)) < MAX_ASCII)
  359. #define CHAR_TO_ASCII(object) ((object) & MASK_ASCII)
  360.  
  361. #define MAKE_CHAR(bucky_bits, code)                    \
  362.   (MAKE_OBJECT                                \
  363.    (TC_CHARACTER,                            \
  364.     (((unsigned long) (bucky_bits)) << (CODE_LENGTH)) | (code)))
  365.  
  366. #define CHAR_BITS(chr)                        \
  367.   ((((unsigned long) (OBJECT_DATUM (chr))) >> CODE_LENGTH) & CHAR_MASK_BITS)
  368.  
  369. #define CHAR_CODE(chr) ((OBJECT_DATUM (chr)) & CHAR_MASK_CODE)
  370.  
  371. /* Fixnum Operations */
  372.  
  373. #define FIXNUM_ZERO_P(fixnum) ((OBJECT_DATUM (fixnum)) == 0)
  374. #define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
  375. #define UNSIGNED_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
  376. #define FIXNUM_EQUAL_P(x, y) ((OBJECT_DATUM (x)) == (OBJECT_DATUM (y)))
  377. #define FIXNUM_LESS_P(x, y) ((FIXNUM_TO_LONG (x)) < (FIXNUM_TO_LONG (y)))
  378.  
  379. #define FIXNUM_POSITIVE_P(fixnum)                    \
  380.   (! ((FIXNUM_ZERO_P (fixnum)) || (FIXNUM_NEGATIVE_P (fixnum))))
  381.  
  382. #define UNSIGNED_FIXNUM_TO_LONG(fixnum) ((long) (OBJECT_DATUM (fixnum)))
  383. #define LONG_TO_UNSIGNED_FIXNUM_P(value) (((value) & SIGN_MASK) == 0)
  384. #define LONG_TO_UNSIGNED_FIXNUM(value) (FIXNUM_ZERO + (value))
  385. #define LONG_TO_FIXNUM(value) (OBJECT_NEW_TYPE (TC_FIXNUM, (value)))
  386.  
  387. #define LONG_TO_FIXNUM_P(value)                        \
  388.   ((((value) & SIGN_MASK) == 0) || (((value) & SIGN_MASK) == SIGN_MASK))
  389.  
  390. #define FIXNUM_TO_LONG(fixnum)                        \
  391.   ((((long) (fixnum)) ^ ((long) FIXNUM_SIGN_BIT))            \
  392.    - ((long) ((TC_FIXNUM << DATUM_LENGTH) | FIXNUM_SIGN_BIT)))
  393.  
  394. #define FIXNUM_TO_DOUBLE(fixnum) ((double) (FIXNUM_TO_LONG (fixnum)))
  395.  
  396. #define DOUBLE_TO_FIXNUM_P(number)                    \
  397.   (((number) > (((double) SMALLEST_FIXNUM) - 0.5)) &&            \
  398.    ((number) < (((double) BIGGEST_FIXNUM) + 0.5)))
  399.  
  400. #ifdef HAVE_DOUBLE_TO_LONG_BUG
  401. #define DOUBLE_TO_FIXNUM double_to_fixnum
  402. #else
  403. #define DOUBLE_TO_FIXNUM(number) (LONG_TO_FIXNUM ((long) (number)))
  404. #endif
  405.  
  406. /* Bignum Operations */
  407.  
  408. #define BIGNUM_ZERO_P(bignum)                        \
  409.   ((bignum_test (bignum)) == bignum_comparison_equal)
  410.  
  411. #define BIGNUM_NEGATIVE_P(bignum)                    \
  412.   ((bignum_test (bignum)) == bignum_comparison_less)
  413.  
  414. #define BIGNUM_POSITIVE_P(bignum)                    \
  415.   ((bignum_test (bignum)) == bignum_comparison_greater)
  416.  
  417. #define BIGNUM_LESS_P(x, y)                        \
  418.   ((bignum_compare ((x), (y))) == bignum_comparison_less)
  419.  
  420. #define BIGNUM_TO_LONG_P(bignum)                    \
  421.   (bignum_fits_in_word_p ((bignum), ((sizeof (long)) * CHAR_BIT), 1))
  422.  
  423. /* If precision should not be lost,
  424.    compare to DBL_MANT_DIG instead. */
  425. #define BIGNUM_TO_DOUBLE_P(bignum)                    \
  426.   (bignum_fits_in_word_p ((bignum), DBL_MAX_EXP, 0))
  427.  
  428. /* Flonum Operations */
  429.  
  430. #define FLONUM_TO_DOUBLE(object)                    \
  431.   (* ((double *) (MEMORY_LOC ((object), 1))))
  432.  
  433. #define FLOAT_TO_FLONUM(expression)                    \
  434.   (double_to_flonum ((double) (expression)))
  435.  
  436. #define FLONUM_TRUNCATE(object)                        \
  437.   (double_to_flonum (double_truncate (FLONUM_TO_DOUBLE (object))))
  438.  
  439. /* Numeric Type Conversions */
  440.  
  441. #define BIGNUM_TO_FIXNUM_P(bignum)                    \
  442.   (bignum_fits_in_word_p ((bignum), (FIXNUM_LENGTH + 1), 1))
  443.  
  444. #define FIXNUM_TO_BIGNUM(fixnum) (long_to_bignum (FIXNUM_TO_LONG (fixnum)))
  445. #define FIXNUM_TO_FLONUM(fixnum) (double_to_flonum (FIXNUM_TO_DOUBLE (fixnum)))
  446. #define BIGNUM_TO_FIXNUM(bignum) (LONG_TO_FIXNUM (bignum_to_long (bignum)))
  447. #define BIGNUM_TO_FLONUM_P BIGNUM_TO_DOUBLE_P
  448. #define BIGNUM_TO_FLONUM(bignum) (double_to_flonum (bignum_to_double (bignum)))
  449. #define FLONUM_TO_BIGNUM(flonum) (double_to_bignum (FLONUM_TO_DOUBLE (flonum)))
  450. #define FLONUM_TO_INTEGER(x) (double_to_integer (FLONUM_TO_DOUBLE (x)))
  451. #define INTEGER_TO_FLONUM_P integer_to_double_p
  452. #define INTEGER_TO_FLONUM(n) (double_to_flonum (integer_to_double (n)))
  453.  
  454. #define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
  455. #define OBJECT_TO_BOOLEAN(object) ((object) != SHARP_F)
  456.  
  457. #define MAKE_BROKEN_HEART(address)                    \
  458.   (BROKEN_HEART_ZERO + (ADDRESS_TO_DATUM (address)))
  459.  
  460. #define BYTES_TO_WORDS(nbytes)                        \
  461.   (((nbytes) + ((sizeof (SCHEME_OBJECT)) - 1)) / (sizeof (SCHEME_OBJECT)))
  462.  
  463. #define ADDRESS_CONSTANT_P(address)                    \
  464.   (((address) >= Constant_Space) && ((address) < Free_Constant))
  465.  
  466. #define ADDRESS_PURE_P(address)                        \
  467.   ((ADDRESS_CONSTANT_P (address)) && (Pure_Test (address)))
  468.  
  469. #define SIDE_EFFECT_IMPURIFY(Old_Pointer, Will_Contain)            \
  470. if ((ADDRESS_CONSTANT_P (OBJECT_ADDRESS (Old_Pointer))) &&        \
  471.     (GC_Type (Will_Contain) != GC_Non_Pointer) &&            \
  472.     (! (ADDRESS_CONSTANT_P (OBJECT_ADDRESS (Will_Contain)))) &&        \
  473.     (Pure_Test (OBJECT_ADDRESS (Old_Pointer))))                \
  474.   signal_error_from_primitive (ERR_WRITE_INTO_PURE_SPACE);        \
  475.  
  476. #ifdef FLOATING_ALIGNMENT
  477.  
  478. #define FLOATING_BUFFER_SPACE                        \
  479.   ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT)))
  480.  
  481. #define HEAP_BUFFER_SPACE                        \
  482.   (TRAP_MAX_IMMEDIATE + 1 + FLOATING_BUFFER_SPACE)
  483.  
  484. /* The space is there, find the correct position. */
  485.  
  486. #define INITIAL_ALIGN_FLOAT(Where)                    \
  487. {                                    \
  488.   while ((((long) ((Where) + 1)) & FLOATING_ALIGNMENT) != 0)        \
  489.     Where -= 1;                                \
  490. }
  491.  
  492. #define ALIGN_FLOAT(Where)                        \
  493. {                                    \
  494.   while ((((long) ((Where) + 1)) & FLOATING_ALIGNMENT) != 0)        \
  495.     *Where++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));        \
  496. }
  497.  
  498. #else /* not FLOATING_ALIGNMENT */
  499.  
  500. #define HEAP_BUFFER_SPACE         (TRAP_MAX_IMMEDIATE + 1)
  501.  
  502. #define INITIAL_ALIGN_FLOAT(Where)
  503. #define ALIGN_FLOAT(Where)
  504.  
  505. #endif /* not FLOATING_ALIGNMENT */
  506.